home *** CD-ROM | disk | FTP | other *** search
Modula Implementation | 1995-11-25 | 12.0 KB | 408 lines |
- IMPLEMENTATION MODULE PreisErfassung;
- (***************************** IMPORT ******************************)
- FROM BlRscInc IMPORT VKPDIA , EKPDIA , (* TREE *) VKBIER , VKLIMO ,
- CANCELVK , OKVK , EKB1 , EKB2 , EKB3 , EKB4 , EKB5 , EKB6 ,
- EKB7 , EKL1 , EKL2 , EKL3 , EKL4 , EKL5 , EKL6 , EKL7 ,
- CANCELEK , OKEK ,DATEDIA, DATUM, CANCDAT, OKDATUM,
- SaveFileName;
-
- FROM SYSTEM IMPORT ADDRESS;
- FROM AES IMPORT FormAlert,ResourceGetAddr;
- FROM EasyDialog IMPORT DoDialog,and,GetText,SetText,IsSelected;
- FROM ConvertStr IMPORT StrToInt,IntToStr;
- FROM Strings IMPORT IsEmptyStr,EqualStr,LeftStr,SubStr,ClearStr,Length,
- Concat;
- FROM InOut IMPORT WriteString,WriteLn,WriteInt,Done,ReadInt,
- ReadLine,ReadString,
- OpenOutput,CloseOutput,OpenInput,CloseInput;
-
-
- (************************* VAR ********************************)
- VAR EKDiaAddr : ADDRESS;
- VKDiaAddr : ADDRESS;
- EndStr : ARRAY [0..5] OF CHAR;
- i,k : INTEGER;
- (*************************** CONST ******************************)
-
- (*************************** BEGIN ******************************)
-
- PROCEDURE GetDate():BOOLEAN;
- VAR String,SaveString :ARRAY [1..6] OF CHAR;
- DateDiaAddr :ADDRESS;
- DiaReturn :INTEGER;
- dd,mm,jj :INTEGER;
- OK,Valid :BOOLEAN;
- Null,UnderScore : ARRAY [0..0] OF CHAR;
-
- BEGIN
- Null[0]:='0'; UnderScore[0]:='_';
- ResourceGetAddr(0,DATEDIA,DateDiaAddr);
- GetText(DATUM,DateDiaAddr,SaveString);
- REPEAT
- DiaReturn:=DoDialog(DateDiaAddr,DATUM);
- Valid:=TRUE;
- IF DiaReturn#CANCDAT THEN
- GetText(DATUM,DateDiaAddr,String);
- SubStr(String,1,2,DD,OK);
-
- StrToInt(DD,dd,OK);
- IntToStr(dd,2,DD,OK);
- Valid:=Valid AND (dd<32);
- SubStr(DD,2,2,DD,OK);
- IF Length(DD)<2 THEN
- Concat(Null,DD,DD,OK);
- END(*IF*);
-
- SubStr(String,3,2,MM,OK);
- StrToInt(MM,mm,OK);
- IntToStr(mm,2,MM,OK);
- Valid:=Valid AND (mm<13);
-
- SubStr(MM,2,2,MM,OK);
- IF Length(MM)<2 THEN
- Concat(Null,MM,MM,OK);
- END(*IF*);
-
-
- SubStr(String,5,2,JJ,OK);
- StrToInt(JJ,jj,OK);
- IntToStr(jj,2,JJ,OK);
- Valid:=Valid AND (jj>93);
- SubStr(JJ,2,2,JJ,OK);
- IF Length(JJ)<2 THEN
- Concat(Null,JJ,JJ,OK);
- END(*IF*);
- ELSE
- SetText(DATUM,DateDiaAddr,SaveString);
- END(*IF*);
- IF Valid THEN
- ClearStr(SaveFileName);
- Concat(SaveFileName,JJ,SaveFileName,OK);
- Concat(SaveFileName,UnderScore,SaveFileName,OK);
- Concat(SaveFileName,MM,SaveFileName,OK);
- Concat(SaveFileName,UnderScore,SaveFileName,OK);
- Concat(SaveFileName,DD,SaveFileName,OK);
- Concat(SaveFileName,'.DAT',SaveFileName,OK);
- END(*IF*);
- UNTIL Valid;
- IF DiaReturn=CANCDAT THEN
- RETURN FALSE
- ELSE
- RETURN TRUE
- END(*IF*);
- END GetDate;
-
-
-
- PROCEDURE SetVkPreisText;
- VAR OK:BOOLEAN;
- VKPString : ARRAY [0..3] OF CHAR;
- Null : ARRAY [0..0] OF CHAR;
-
- BEGIN
- ResourceGetAddr(0,VKPDIA,VKDiaAddr);
- Null[0]:='0';
- IntToStr( VerkaufsPreis.BierPreis,3,VKPString,OK);
- SubStr(VKPString,2,3,VKPString,OK);
- IF Length(VKPString)<3 THEN
- Concat(Null,VKPString,VKPString,OK);
- END(*IF*);
- IF OK THEN
- SetText(VKBIER,VKDiaAddr,VKPString);
- END(*IF*);
- IntToStr( VerkaufsPreis.LimoPreis,3,VKPString,OK);
- SubStr(VKPString,2,3,VKPString,OK);
- IF Length(VKPString)<3 THEN
- Concat(Null,VKPString,VKPString,OK);
- END(*IF*);
- IF OK THEN
- SetText(VKLIMO,VKDiaAddr,VKPString);
- END(*IF*);
- END SetVkPreisText;
-
- PROCEDURE ValidInput(String:ARRAY OF CHAR;i:INTEGER):BOOLEAN;
- VAR VglStr1,
- VglStr2 : GTString;
- IntStr : ARRAY[0..1] OF CHAR;
- OK : BOOLEAN;
- DM,Pf,FlProKast:INTEGER;
- EKP1,
- EKP2 : EKPreis;
- BEGIN
- VglStr1:='';VglStr2:='';
- DM:=0;Pf:=0;FlProKast:=0;
- IF IsEmptyStr(String) THEN RETURN FALSE END(*IF*);
- LeftStr(String,16,VglStr1,OK);
- IF IsEmptyStr(VglStr1) THEN RETURN FALSE END(*IF*);
- VglStr2:='________________';
- LeftStr(VglStr2,16,VglStr2,OK);
- IF EqualStr(VglStr1,VglStr2) THEN RETURN FALSE END(*IF*);
- VglStr2:=' ';
- LeftStr(VglStr2,16,VglStr2,OK);
- IF EqualStr(VglStr1,VglStr2) THEN RETURN FALSE END(*IF*);
- SubStr(String,17,2,IntStr,OK);
- StrToInt(IntStr,DM,OK);
- SubStr(String,19,2,IntStr,OK);
- StrToInt(IntStr,Pf,OK);
- Pf:=100*DM+Pf;
- SubStr(String,21,2,IntStr,OK);
- StrToInt(IntStr,FlProKast,OK);
- IF (Pf=0) OR (FlProKast=0) THEN RETURN FALSE END(*IF*);
- EinKaufsPreis[i].TreeIndex:=i;
- EinKaufsPreis[i].Getraenk:=VglStr1;
- EinKaufsPreis[i].Preis:=Pf;
- EinKaufsPreis[i].FlaschenProKasten:=FlProKast;
- RETURN TRUE
- END ValidInput;
-
- PROCEDURE LoadPreise;
- VAR s : ARRAY [0..255] OF CHAR;
- String : ARRAY [0..21] OF CHAR;
- Index : INTEGER;
- OK : BOOLEAN;
- i : INTEGER;
- BEGIN
- IF Done THEN
- ReadInt(VerkaufsPreis.BierPreis);
- ReadInt(VerkaufsPreis.LimoPreis);
- END(*IF*);
- SetVkPreisText;
- ResourceGetAddr(0,EKPDIA,EKDiaAddr);
- WHILE ~EqualStr(s, EndStr)AND Done DO
- ReadLine(s);
- LeftStr(s,22,String,OK);
- ReadInt(Index);
- i:=Index;
- EinKaufsPreis[i].TreeIndex:=Index;
- ReadInt(EinKaufsPreis[i].NeuBezogeneKaesten);
- ReadInt(EinKaufsPreis[i].ZuBezahlendeKaesten);
- ReadInt(EinKaufsPreis[i].KaestenGes);
- EinKaufsPreis[i].KaestenGes:= EinKaufsPreis[i].KaestenGes+
- EinKaufsPreis[i].NeuBezogeneKaesten;
- EinKaufsPreis[i].ZuBezahlendeKaesten:= EinKaufsPreis[i].NeuBezogeneKaesten+
- EinKaufsPreis[i].ZuBezahlendeKaesten;
- EinKaufsPreis[i].NeuBezogeneKaesten:=0;
- IF ValidInput(s,Index) THEN
- SetText(Index,EKDiaAddr,String);
- END(*IF*);
- END(*WHILE*);
- END LoadPreise;
-
- PROCEDURE LoadOldPreise;
- VAR s : ARRAY [0..255] OF CHAR;
- String : ARRAY [0..21] OF CHAR;
- Index : INTEGER;
- OK : BOOLEAN;
-
- BEGIN
- IF Done THEN
- ReadInt(VerkaufsPreis.BierPreis);
- ReadInt(VerkaufsPreis.LimoPreis);
- END(*IF*);
- SetVkPreisText;
- ResourceGetAddr(0,EKPDIA,EKDiaAddr);
- WHILE ~EqualStr(s, '#&$!*')AND Done DO
- ReadLine(s);
- LeftStr(s,22,String,OK);
- ReadInt(Index);i:=Index;
- ReadInt(EinKaufsPreis[i].NeuBezogeneKaesten);
- ReadInt(EinKaufsPreis[i].ZuBezahlendeKaesten);
- ReadInt(EinKaufsPreis[i].KaestenGes);
- IF ValidInput(s,Index) THEN
- SetText(Index,EKDiaAddr,String);
- END(*IF*);
- END(*WHILE*);
- END LoadOldPreise;
-
-
- PROCEDURE SavePreise;
- TYPE EinString = ARRAY [0..21] OF CHAR;
-
- VAR s:ARRAY [0..255] OF CHAR;
- i,preis:INTEGER;
-
- String :EinString;
- StrArray :ARRAY [1..14] OF EinString;
- PROCEDURE WritePreis;
- BEGIN
- WriteString(String);WriteLn;
- WriteInt(EinKaufsPreis[i].TreeIndex,7);
- WriteInt(EinKaufsPreis[i].NeuBezogeneKaesten,7);
- WriteInt(EinKaufsPreis[i].ZuBezahlendeKaesten,7);
- WriteInt(EinKaufsPreis[i].KaestenGes,7);
- WriteLn;
- END WritePreis;
-
- BEGIN
- ClearStr(s);
- IF Done THEN
- WriteInt(VerkaufsPreis.BierPreis,10);
- WriteInt(VerkaufsPreis.LimoPreis,10);
- WriteLn;
- END(*IF*);
- ResourceGetAddr(0,EKPDIA,VKDiaAddr);
- IF Done THEN
- FOR i:=EKB1 TO EKB7 DO
- GetText(i,EKDiaAddr,String);
- IF ValidInput(String,i) THEN
- WritePreis;
- END(*IF*);
- END(*FOR*);
- FOR i:=EKL1 TO EKL7 DO
- GetText(i,EKDiaAddr,String);
- IF ValidInput(String,i) THEN
- WritePreis;
- END(*IF*);
- END(*FOR*);
- END(*IF*);
- WriteString(EndStr);WriteLn;
- WriteInt(0,3); WriteInt(0,3);
- WriteInt(0,3); WriteInt(0,3);WriteLn;
- END SavePreise;
-
- PROCEDURE Nullbelegung(m:INTEGER);
- BEGIN
- EinKaufsPreis[m].NeuBezogeneKaesten:=0;
- EinKaufsPreis[m].ZuBezahlendeKaesten:=0;
- EinKaufsPreis[m].KaestenGes:=0;
- EinKaufsPreis[m].Getraenk:=' ';
- EinKaufsPreis[m].Preis:=0;
- EinKaufsPreis[m].FlaschenProKasten:=0;
- END Nullbelegung;
-
-
- PROCEDURE Alert;
- VAR fr :INTEGER;
- formstr : ARRAY [0..127] OF CHAR;
- BEGIN
-
- formstr:='[1][ Sie können den Eintrag erst |löschen wenn diese Getränke| bezahlt sind !][ OK ]';
- fr:=FormAlert(1,formstr)
-
- END Alert;
-
- PROCEDURE EinkaufsPreise;
- VAR DiaReturn,i :INTEGER;
- String :ARRAY [0..21] OF CHAR;
- StringArray :ARRAY [EKB1..EKL7],[0..21] OF CHAR;
- OK :BOOLEAN;
-
- BEGIN
- ResourceGetAddr(0,EKPDIA,EKDiaAddr);
- FOR i:=EKB1 TO EKB7 DO
- GetText(i,EKDiaAddr,StringArray[i]);
- END(*FOR*);
- FOR i:=EKL1 TO EKL7 DO
- GetText(i,EKDiaAddr,StringArray[i]);
- END(*FOR*);
-
- DiaReturn:=DoDialog(EKDiaAddr,EKB1);
- IF DiaReturn=OKEK THEN
- FOR i:=EKB1 TO EKB7 DO
- GetText(i,EKDiaAddr,String);
- IF ~ValidInput(String,i) THEN
- IF EinKaufsPreis[i].NeuBezogeneKaesten+
- EinKaufsPreis[i].ZuBezahlendeKaesten # 0 THEN
- Alert;
- SetText(i,EKDiaAddr,StringArray[i]);
- ELSE
- Nullbelegung(i);
- END(*IF*);
- END(*IF*);
- END(*FOR*);
- FOR i:=EKL1 TO EKL7 DO
- GetText(i,EKDiaAddr,String);
- IF ~ValidInput(String,i) THEN
- IF EinKaufsPreis[i].NeuBezogeneKaesten+
- EinKaufsPreis[i].ZuBezahlendeKaesten # 0 THEN
- Alert;
- SetText(i,EKDiaAddr,StringArray[i]);
- ELSE
- Nullbelegung(i);
- END(*IF*);
- END(*IF*);
- END(*FOR*);
- ELSE
- FOR i:=EKB1 TO EKB7 DO
- SetText(i,EKDiaAddr,StringArray[i]);
- END(*FOR*);
- FOR i:=EKL1 TO EKL7 DO
- SetText(i,EKDiaAddr,StringArray[i]);
- END(*FOR*);
- END(*IF*);
- END EinkaufsPreise;
-
- PROCEDURE VerkaufsPreise;
- VAR DiaReturn :INTEGER;
- preis :INTEGER;
- String : ARRAY [0..2] OF CHAR;
- OK : BOOLEAN;
- BEGIN
- ResourceGetAddr(0,VKPDIA,VKDiaAddr);
- DiaReturn:=DoDialog(VKDiaAddr,VKBIER);
- IF DiaReturn= OKVK THEN
- GetText(VKBIER,VKDiaAddr,String);
- StrToInt(String,preis,OK);
- VerkaufsPreis.BierPreis:=preis;
- GetText(VKLIMO,VKDiaAddr,String);
- StrToInt(String,preis,OK);
- VerkaufsPreis.LimoPreis:=preis;
- ELSE
- SetVkPreisText;
- END(*IF*);
- END VerkaufsPreise;
-
- PROCEDURE GetPreferences(VAR Ordnen,LeerZeilen:INTEGER):BOOLEAN;
- VAR DatumStr : ARRAY [0..6] OF CHAR;
- Ordnen1,LeerZeilen1:INTEGER;
- DateDiaAddr :ADDRESS;
- OK : BOOLEAN;
- InfoFileName : ARRAY[0..255] OF CHAR;
- BEGIN
- InfoFileName:='BIERKASS.INF';
- OpenInput(InfoFileName);
- IF Done THEN
- ReadString(DatumStr);
- ReadInt(Ordnen1);
- ReadInt(LeerZeilen1);
- IF Done THEN
- ResourceGetAddr(0,DATEDIA,DateDiaAddr);
- SetText(DATUM,DateDiaAddr,DatumStr);
- Ordnen:=Ordnen1;
- LeerZeilen:=LeerZeilen1;
- END(*IF*);
- ELSE
- CloseInput;
- RETURN FALSE
- END(*IF*);
- CloseInput;
- RETURN TRUE
- END GetPreferences;
-
- PROCEDURE SetPreferences( Ordnen,LeerZeilen:INTEGER);
- VAR DatumStr : ARRAY [1..6] OF CHAR;
- DateDiaAddr :ADDRESS;
- OK : BOOLEAN;
- InfoFileName : ARRAY[0..255] OF CHAR;
- BEGIN
- InfoFileName:='BIERKASS.INF';
- OpenOutput(InfoFileName);
- IF Done THEN
- ResourceGetAddr(0,DATEDIA,DateDiaAddr);
- GetText(DATUM,DateDiaAddr,DatumStr);
- WriteString(DatumStr);WriteLn;
- WriteInt(Ordnen,5);
- WriteInt(LeerZeilen,5);
- END(*IF*);
- CloseOutput;
- END SetPreferences;
-
- BEGIN
- FOR k:= EKB1 TO EKL7 DO
- EinKaufsPreis[k].TreeIndex:=0;
- Nullbelegung(k);
- END(*FOR*);
- EndStr:='#&$!*';
-
- END PreisErfassung.
-